home *** CD-ROM | disk | FTP | other *** search
/ Aminet 28 / Aminet 28 (1998)(GTI - Schatztruhe)[!][Dec 1998].iso / Aminet / util / rexx / FWCalendar.lha / FWCalendar / AddEvent.rexx next >
Encoding:
OS/2 REXX Batch file  |  1998-09-26  |  12.1 KB  |  352 lines
  1. /*
  2.     AddEvent Macro
  3.     Adds events to calendars created by my
  4.     Calendar Macro for FinalWriter4+ (SoftWood)
  5.     Written by Ronald Goertz
  6.     $VER: AddEvent v2.40 (26 Sep 98)
  7.  */
  8.  
  9. OPTIONS RESULTS
  10. Address FINALW.1
  11.  
  12. call addlib("rexxreqtools.library", 0, -30, 0)
  13. call addlib("rexxsupport.library", 0, -30, 0)
  14.  
  15. call SetVariables
  16.  
  17. TextBlockTypePrefs SIZE HighlightFSize WIDTH HighlightFWidth COLOR BlackName FONT DateFont
  18. BoxPrefs LINEWT Hairline FILL Solid FILLCOLOR WhiteName
  19.  
  20. Month = substr(TempDate,5,2)
  21. if left(Month,1) == "0" then Month = right(Month,1)
  22. PrevMonth = Month - 1
  23. if PrevMonth = 0 then PrevMonth = 12
  24. NextMonth = Month + 1
  25. if NextMonth = 13 then NextMonth = 1
  26.  
  27. Year = left(TempDate,4)
  28. if (Year//4 == 0 & Year//100 > 0) | Year//400 == 0 Then MonthLength.2  = 29
  29.  
  30. interpret "StartDate = Day."Date('W', TempDate, 'S')
  31.  
  32. if ~exists('t:'TempDate'.gc') then call BuildRequestor
  33.  
  34. Do While 1
  35.   Day1 = ''; Day2 = ''; EnteredLine = 1; Options = ''; EnteredEvent = ''; Box = 0; Weekly = 0
  36.   call openport(TempDate)
  37.   address command "gui t:"TempDate".gc"
  38.   call WaitPkt(TempDate)
  39.   packet = GetPkt(TempDate)
  40.   call Reply(packet,0)
  41.   call closeport(TempDate)
  42.   call open(InData, 'env:EventData')
  43.     input = ReadLn(InData)
  44.   call close(InData)
  45.   if input = "0" then do
  46.     if upper(DecimalFormat) = 'COMMA' then DocItemPrefs Decimal Comma
  47.     exit
  48.   end
  49.   Parse Var input Day1 ',' Day2 ',' EnteredLine ',' Options ',' EnteredEvent
  50.  
  51.   Day1 = strip(Day1)
  52.   if Day1 = '' then do
  53.     call rtezrequest('No day provided.')
  54.     iterate
  55.   end
  56.   Day2 = strip(Day2)
  57.   EnteredLine = strip(EnteredLine)
  58.  
  59.   Options = strip(Options)
  60.   EnteredEvent = strip(EnteredEvent)
  61.   do while pos(DollarSub, EnteredEvent) > 0
  62.     posn = pos(DollarSub, EnteredEvent)
  63.     EnteredEvent = OVERLAY('$', EnteredEvent, posn)
  64.   end
  65.  
  66.   Options = compress(upper(Options))
  67.   if pos('B', Options) ~= 0 | pos('//',Event) ~= 0 then Box = 1
  68.   if pos('W', Options) ~= 0 then Weekly = 1
  69.   If Day2 == "" then Day2 = Day1
  70.  
  71.   do until Weekly = 0
  72.     Event = EnteredEvent
  73.     Line = EnteredLine
  74.  
  75.     If upper(left(Day1,1)) == "P" then Day1 = substr(Day1,2) - MonthLength.PrevMonth
  76.     If upper(left(Day2,1)) == "P" then Day2 = substr(Day2,2) - MonthLength.PrevMonth
  77.     If upper(left(Day1,1)) == "N" then Day1 = substr(Day1,2) + MonthLength.Month
  78.     If upper(left(Day2,1)) == "N" then Day2 = substr(Day2,2) + MonthLength.Month
  79.  
  80.     If Day1 > Day2 then Do
  81.       TempDate = Day1
  82.       Day1 = Day2
  83.       Day2 = TempDate
  84.     End
  85.     If Day1 ~= Day2 then Box = 1
  86.  
  87.     If Day1 <= -StartDate then Do
  88.       ShowMessage 1 0 '"Dates cannot come before" "the beginning of the calendar." "" "OK" "" ""'
  89.       if upper(DecimalFormat) = 'COMMA' then DocItemPrefs Decimal Comma
  90.       Exit
  91.     End
  92.  
  93.     if ((StartDate + MonthLength.Month > 35) & (Day2 > MonthLength.Month)) | ((StartDate + MonthLength.Month < 36) & (Day2 > 35 - StartDate)) then do
  94.       ShowMessage 1 0 '"Dates cannot come after" "the end of the calendar." "" "OK" "" ""'
  95.       if upper(DecimalFormat) = 'COMMA' then DocItemPrefs Decimal Comma
  96.       Exit
  97.     End
  98.  
  99.     Day1Row = trunc((Day1 + StartDate - 1)/7)
  100.     Day2Row = trunc((Day2 + StartDate - 1)/7)
  101.     Day1Column = (Day1 + StartDate) - 7*Day1Row - 1
  102.     LeftEdge = LeftMargin + Day1Column*BoxWidth + TextOffset
  103.     If Day1Row < 5 then PrintRow = Day1Row * BoxHeight
  104.     else PrintRow = trunc(4.5 * BoxHeight)
  105.     
  106.     If Box == 0 then do /* Single day, unboxed event */
  107.       Textline = 1
  108.       event2 = ''
  109.       Do until event == ''
  110.         TextBottom = TopMargin + TextArea + PrintRow + (Line+1)*FHeight*1.1
  111.         TextLeft   = LeftMargin + Day1Column*BoxWidth + TextOffset*Textline
  112.         DrawTextBlock 1 TextLeft TextBottom Event; obj = result
  113.         redraw
  114.         GetObjectCoords obj; coords = result
  115.         parse var coords Pg . . TextWidth .
  116.         If length(event) > 34 then TextWidth = 2*BoxWidth
  117.         if (TextWidth + Textline*TextOffset >= BoxWidth) & (Words(event) > 1) then do
  118.           posn = lastpos(' ', event)
  119.           event2 = strip(substr(event, posn)' 'event2)
  120.           event  = strip(left(event, posn))
  121.           DeleteObject obj
  122.         end
  123.         else if event2 ~= '' then do
  124.           Textline = 3
  125.           Line = Line + 1
  126.           event = event2
  127.           event2 = ''
  128.         end
  129.         else event = ''
  130.       End
  131.     end
  132.     else do until Day1Row > Day2Row /* boxed events*/
  133.       SearchPos = 1
  134.       Found     = 1
  135.       TextRows  = 1
  136.       do until Found = 0
  137.         Found = pos('//',Event,SearchPos)
  138.         if Found > 0 then do
  139.           Text.TextRows = substr(Event,SearchPos,Found - SearchPos)
  140.           SearchPos = Found + 2
  141.           TextRows = TextRows + 1
  142.         end
  143.         else Text.TextRows = substr(Event,SearchPos)
  144.       end
  145.  
  146.       if Day2Row > Day1Row then CurrentWidth = (LeftMargin + 7*BoxWidth) - LeftEdge
  147.       else Do
  148.         Day2Column = (Day2 + StartDate) - 7*Day2Row - 1
  149.         CurrentWidth = (LeftMargin + (Day2Column + 1)*BoxWidth - TextOffset) - LeftEdge
  150.       End
  151.  
  152.       /* The only number in the following line may need to be adjusted (larger for smaller fonts,
  153.          smaller for larger fonts) */
  154.       TopEdge = TopMargin + TextArea + PrintRow + Line*FHeight*1.1 + (FHeight * .3)
  155.       DrawBox 1 LeftEdge TopEdge CurrentWidth FHeight*TextRows*1.1
  156.  
  157.       do i = 1 to TextRows
  158.         TextBottom = TopMargin + TextArea + PrintRow + (Line+i)*FHeight*1.1
  159.         DrawTextBlock 1 1 TextBottom Text.i
  160.         ID = RESULT
  161.         GetObjectCoords ID
  162.         parse var result . . . TextWidth TextHeight
  163.         TextLeft = LeftEdge + (CurrentWidth - TextWidth)/2
  164.         SetObjectCoords ID 1 TextLeft TextBottom TextWidth TextHeight
  165.       end
  166.  
  167.       Day1Row = Day1Row + 1
  168.       If Day1Row < 5 then PrintRow = Day1Row * BoxHeight
  169.       else PrintRow = trunc(4.5 * BoxHeight)
  170.       LeftEdge = LeftMargin
  171.     End
  172.     if Weekly == 1 then do
  173.        Day1 = Day1 + 7
  174.        Day2 = Day2 + 7
  175.        if ((StartDate + MonthLength.Month > 35) & (Day2 > MonthLength.Month)) | ((StartDate + MonthLength.Month < 36) & (Day2 > 35 - StartDate)) then Weekly = 0
  176.        if ((StartDate + MonthLength.Month > 35) & (Day1 > MonthLength.Month)) | ((StartDate + MonthLength.Month < 36) & (Day1 > 35 - StartDate)) then Weekly = 0
  177.     end
  178.   end
  179.   Redraw
  180.   SelectObject
  181. End
  182.  
  183. /*******  BuildRequestor Subroutine  ***********/
  184. BuildRequestor: Procedure expose PrevMonth Month NextMonth Month. MonthLength. TempDate StartDate LF Day.
  185.  
  186. Left   = 5
  187. Top    = 40
  188. RWidth = 17
  189. Height = 12
  190. PMonth = left(Month.PrevMonth, 3)
  191. CMonth = left(Month.Month, 3)
  192. NMonth = left(Month.NextMonth, 3)
  193.  
  194. call open(Req, 't:'TempDate'.gc', W)
  195.   Text = 'G4C'LF'WINBIG 261 180 230 130 "Enter event information:"'LF'WinType 11110000'LF'xOnLoad'LF
  196.   Text = Text'GuiOpen 'TempDate'.gc'LF'StartEnd = 1'LF'Line = 1'LF'PMonth = "'PMonth'"'LF
  197.   Text = Text'Month = "'CMonth'"'LF'NMonth = "'NMonth'"'LF'StartTxt = "Start: "'LF'EndTxt = "  End: "'LF
  198.   Text = Text'..EventData = "0"'LF'AppName = "'TempDate'.gc"'LF'xOnClose'LF'SENDREXX "'TempDate'" "Done"'LF'GuiQuit $AppName'LF
  199.   Text = Text'XTEXTIN 50 5 175 15 "Event:" Event "" 100'LF'TEXT 140 25 100 12 "Start:" 13 nobox'LF
  200.   Text = Text'GadID 1'LF'TEXT 140 40 100 12 "  End:" 13 nobox'LF'GadID 2'LF'XCYCLER 184 55 35 11 "Line:" Line'LF
  201.   Text = Text'CSTR 1 1'LF'CSTR 2 2'LF'CSTR 3 3'LF'CSTR 4 4'LF'CSTR 5 5'LF'CSTR 6 6'LF'CSTR 7 7'LF'CSTR 8 8'LF'CSTR 9 9'LF
  202.   Text = Text'XCHECKBOX 184 70 26 11 " Boxed:" "Box" "B" "" OFF'LF'XCHECKBOX 184 85 26 11 "Weekly:" "Weekly" "W" "" OFF'LF
  203.   Text = Text'XBUTTON 133 100 45 14 "  _OK  "'LF'Options = $Box'LF'AppVar Options $Weekly'LF
  204.   Text = Text'..EventData = "$StartDate\, $EndDate\, $Line\, $Options\, $Event\n"'LF
  205.   Text = Text'Quit'LF'XBUTTON 180 100 45 14 "_Cancel"'LF'QUIT'LF
  206.   Text = Text'TEXT 5 25 119 12 "'Month.Month'" 9 BOX'LF'GadTXT CENTER'LF'Text 11 38 8 12 "'left(Day.0,1)'" 1 nobox'LF
  207.   Text = Text'Text 28 38 8 12 "'left(Day.1,1)'" 1 nobox'LF'Text 45 38 8 12 "'left(Day.2,1)'" 1 nobox'LF'Text 62 38 8 12 "'left(Day.3,1)'" 1 nobox'LF
  208.   Text = Text'Text 79 38 8 12 "'left(Day.4,1)'" 1 nobox'LF'Text 96 38 8 12 "'left(Day.5,1)'" 1 nobox'LF'Text 113 38 8 12 "'left(Day.6,1)'" 1 nobox'LF
  209.  
  210.   i = 0
  211.   Day = 0
  212.   PrevDay = MonthLength.PrevMonth - StartDate
  213.   NextDay = 0
  214.   Do while (i < 6)
  215.     j = 0
  216.     Do while (j < 7)
  217.       SerialPosition = (i * 7) + j
  218.       if (SerialPosition >= StartDate) & (SerialPosition < StartDate + MonthLength.Month) then Do
  219.         Day = Day + 1
  220.         Text = Text'XBUTTON 'Left + j*RWidth' 'Top + 10 + i*Height' 'RWidth' 'Height' "'Day'"'LF
  221.         Text = Text'GOSUB $AppName SetDate "'CMonth' 'Day'" ""'LF
  222.       End
  223.       else Do
  224.         if SerialPosition < StartDate then Do
  225.           PrevDay = PrevDay + 1
  226.           Text = Text'XBUTTON 'Left + j*RWidth' 'Top + 10 + i*Height' 'RWidth' 'Height' "'PrevDay'"'LF
  227.           Text = Text'GOSUB $AppName SetDate "'PMonth' 'PrevDay'" "P"'LF
  228.         End
  229.         else Do
  230.           NextDay = NextDay + 1
  231.           Text = Text'XBUTTON 'Left + j*RWidth' 'Top + 10 + i*Height' 'RWidth' 'Height' "'NextDay'"'LF
  232.           Text = Text'GOSUB $AppName SetDate "'NMonth' 'NextDay'" "N"'LF
  233.         End
  234.       End
  235.       j = j + 1
  236.     End
  237.     i = i + 1
  238.     if SerialPosition >= StartDate + MonthLength.Month - 1 then leave
  239.   End
  240.  
  241.   Text = Text'xRoutine SetDate Date Month'LF'StartEnd == 1 - $StartEnd'LF'SE == $StartEnd + 1'LF
  242.   Text = Text'if $SE = 1'LF'Val = $StartTxt'LF'StartDate = $Month'LF'AppVar StartDate $Date[-2][2]'LF
  243.   Text = Text'else'LF'Val = $EndTxt'LF'EndDate = $Month'LF'AppVar EndDate $Date[-2][2]'LF'endif'LF
  244.   Text = Text'AppVar Val $Date'LF'update $AppName $SE $Val'LF'return'
  245. call WriteLn(Req, Text)
  246. call close(Req)
  247.  
  248. return
  249.  
  250. /*******  CalculateDate Subroutine  ***********/
  251. CalculateDate:
  252. /* Month    is the month in which the highlight occurs                        */
  253. /* HighDate is the highest (numerical) date on which the highlight will occur */
  254. /* HighDay  is the weekday on which HighDate will occur                       */
  255. /* Event    is the highlight text                                             */
  256. parse arg GD_Month, GD_HighDay, GD_HighDate, GD_Event
  257.  
  258. interpret 'GD_HighDay = Day.'GD_HighDay
  259. interpret 'GD_First = Day.'Date(W, Year''right(GD_Month, 2, '0')'01', S)
  260.  
  261. GD_Day = GD_HighDate + (GD_HighDay - GD_First)
  262. if GD_First < GD_HighDay then GD_Day = GD_Day - 7
  263. Highlight.GD_Month.GD_Day = GD_Event
  264. return 0
  265.  
  266. /*******  SetVariables Subroutine  ***********/
  267. SetVariables:
  268. DateFont        = "SoftSans"
  269. HighlightFSize  = 8
  270. HighlightFWidth = 100
  271. DollarSub       = 'ยข'
  272.  
  273. Day.Sunday    = 0
  274. Day.Monday    = 1
  275. Day.Tuesday   = 2
  276. Day.Wednesday = 3
  277. Day.Thursday  = 4
  278. Day.Friday    = 5
  279. Day.Saturday  = 6
  280.  
  281. Day.0 = 'Sunday'
  282. Day.1 = 'Monday'
  283. Day.2 = 'Tuesday'
  284. Day.3 = 'Wednesday'
  285. Day.4 = 'Thursday'
  286. Day.5 = 'Friday'
  287. Day.6 = 'Saturday'
  288.  
  289. Month.1  = 'January'
  290. Month.2  = 'February'
  291. Month.3  = 'March'
  292. Month.4  = 'April'
  293. Month.5  = 'May'
  294. Month.6  = 'June'
  295. Month.7  = 'July'
  296. Month.8  = 'August'
  297. Month.9  = 'September'
  298. Month.10 = 'October'
  299. Month.11 = 'November'
  300. Month.12 = 'December'
  301.  
  302. MonthLength.1  = 31
  303. MonthLength.2  = 28
  304. MonthLength.3  = 31
  305. MonthLength.4  = 30
  306. MonthLength.5  = 31
  307. MonthLength.6  = 30
  308. MonthLength.7  = 31
  309. MonthLength.8  = 31
  310. MonthLength.9  = 30
  311. MonthLength.10 = 31
  312. MonthLength.11 = 30
  313. MonthLength.12 = 31
  314.  
  315. if exists(Pragma(D)'/FWMacros/FWCalendar.data') then do
  316.   call open(DataFile, Pragma(D)'/FWMacros/FWCalendar.data')
  317.     do until eof(DataFile)
  318.       Ln = ReadLn(DataFile)
  319.       if left(Ln, 15) == '/* End Pass One' then leave
  320.       interpret Ln
  321.     end
  322.   call close(DataFile)
  323. end
  324.  
  325. LF     = '0a'x
  326.  
  327. GetDocItemPrefs Decimal; DecimalFormat = result
  328. DocItemPrefs Decimal Period
  329. GetPageSetup Width Height
  330. parse var result FullWidth FullHeight
  331.  
  332. GetDisplayPrefs Measure; Units = result
  333. select
  334.   when Units = 'Inches' then PointsPerUnit = 72
  335.   when Units = 'Metric' then PointsPerUnit = 28.34645669291
  336.   when Units = 'Pica' then   PointsPerUnit = 12
  337. end
  338.  
  339. FHeight    = HighlightFSize / PointsPerUnit
  340. TextOffset = 3.6 / PointsPerUnit
  341.  
  342. GetTextBlockText 2; TempDate = RESULT
  343. GetTextBlockText 3; Margins = result
  344. parse var Margins TopMargin'|'BottomMargin'|'LeftMargin'|'RightMargin'|'TextArea
  345. SelectObject
  346.  
  347. PageWidth  = FullWidth - LeftMargin - RightMargin
  348. PageHeight = FullHeight - TopMargin - BottomMargin
  349. BoxWidth   = PageWidth/7
  350. if TextArea == '' then TextArea = .15 * PageHeight
  351. BoxHeight  = (PageHeight-TextArea)/5
  352.